R Notebook

Set working directory and load necessary packages.

Load the data for March. Load each file

dir('./March 18')

 [1] "Combined_March.csv" "March_1.csv"        "March_10.csv"       "March_11.csv"      
 [5] "March_12.csv"       "March_18"           "March_2.csv"        "March_3.csv"       
 [9] "March_4.csv"        "March_5.csv"        "March_6.csv"        "March_7.csv"       
[13] "March_8.csv"        "March_9.csv"       

path <- './March 18'
### list out all the csv files that start with TT_ and then have a number. This will avoid loading in the unwanted aggregated files or VMT files.
###'^_\\d.' returns all files that end with _some_digit.csv.
list_csv <- dir(path=path,pattern = '*_\\d.csv')
myfiles <- lapply(paste(path,'/',list_csv,sep=''),
                  function(x) read.csv(x,stringsAsFactors = FALSE))
files <- mapply(cbind,myfiles,'filename' = list_csv,SIMPLIFY = F)
dat <- bind_rows(files)
rm(myfiles,files)
#create a dataset that we will edit....
March_18_dat <- dat

colnames(March_18_dat)

  [1] "X"         "X.1"       "X.2"       "X12.15.AM" "X12.30.AM" "X12.45.AM" "X1.AM"    
  [8] "X1.15.AM"  "X1.30.AM"  "X1.45.AM"  "X2.AM"     "X2.15.AM"  "X2.30.AM"  "X2.45.AM" 
 [15] "X3.AM"     "X3.15.AM"  "X3.30.AM"  "X3.45.AM"  "X4.AM"     "X4.15.AM"  "X4.30.AM" 
 [22] "X4.45.AM"  "X5.AM"     "X5.15.AM"  "X5.30.AM"  "X5.45.AM"  "X6.AM"     "X6.15.AM" 
 [29] "X6.30.AM"  "X6.45.AM"  "X7.AM"     "X7.15.AM"  "X7.30.AM"  "X7.45.AM"  "X8.AM"    
 [36] "X8.15.AM"  "X8.30.AM"  "X8.45.AM"  "X9.AM"     "X9.15.AM"  "X9.30.AM"  "X9.45.AM" 
 [43] "X10.AM"    "X10.15.AM" "X10.30.AM" "X10.45.AM" "X11.AM"    "X11.15.AM" "X11.30.AM"
 [50] "X11.45.AM" "Noon"      "X12.15.PM" "X12.30.PM" "X12.45.PM" "X1.PM"     "X1.15.PM" 
 [57] "X1.30.PM"  "X1.45.PM"  "X2.PM"     "X2.15.PM"  "X2.30.PM"  "X2.45.PM"  "X3.PM"    
 [64] "X3.15.PM"  "X3.30.PM"  "X3.45.PM"  "X4.PM"     "X4.15.PM"  "X4.30.PM"  "X4.45.PM" 
 [71] "X5.PM"     "X5.15.PM"  "X5.30.PM"  "X5.45.PM"  "X6.PM"     "X6.15.PM"  "X6.30.PM" 
 [78] "X6.45.PM"  "X7.PM"     "X7.15.PM"  "X7.30.PM"  "X7.45.PM"  "X8.PM"     "X8.15.PM" 
 [85] "X8.30.PM"  "X8.45.PM"  "X9.PM"     "X9.15.PM"  "X9.30.PM"  "X9.45.PM"  "X10.PM"   
 [92] "X10.15.PM" "X10.30.PM" "X10.45.PM" "X11.PM"    "X11.15.PM" "X11.30.PM" "X11.45.PM"
 [99] "Midnight"  "X.3"       "filename" 

Lets fix the column headers first. There are no headers for the first 3 columns and also there appears to be a column at the end of the data frame “X.3”

summary(March_18_dat$X.3)

   Mode    NA's 
logical   39990 

All NAs…. remove.

March_18_dat <- March_18_dat[,!names(March_18_dat) == "X.3"]

Focus on the first three columns

str(March_18_dat[1:3])

'data.frame':   39990 obs. of  3 variables:
 $ X  : int  1180 1180 1180 1180 1180 1180 1180 1180 1180 1180 ...
 $ X.1: chr  "Density" "Density" "Density" "Density" ...
 $ X.2: chr  "2018/03/01" "2018/03/02" "2018/03/03" "2018/03/04" ...

Column 1 is the detector ID Column 2 is the metric Column 3 is the date.

colnames(March_18_dat)[1:3] <- c('Detector_ID','Metric','Date')

Now lets change the data types in the columns

March_18_dat$Metric <- as.factor(March_18_dat$Metric)
March_18_dat$Date_Posixct <- as.POSIXct(March_18_dat$Date,format="%Y/%m/%d")
March_18_dat$Detector_ID <- as.factor(March_18_dat$Detector_ID)
## Check that our dates worked out. We don't want any NAs.
table(March_18_dat$Date_Posixct)

2018-03-01 2018-03-02 2018-03-03 2018-03-04 2018-03-05 2018-03-06 2018-03-07 2018-03-08 
      1290       1290       1290       1290       1290       1290       1290       1290 
2018-03-09 2018-03-10 2018-03-11 2018-03-12 2018-03-13 2018-03-14 2018-03-15 2018-03-16 
      1290       1290       1290       1290       1290       1290       1290       1290 
2018-03-17 2018-03-18 2018-03-19 2018-03-20 2018-03-21 2018-03-22 2018-03-23 2018-03-24 
      1290       1290       1290       1290       1290       1290       1290       1290 
2018-03-25 2018-03-26 2018-03-27 2018-03-28 2018-03-29 2018-03-30 2018-03-31 
      1290       1290       1290       1290       1290       1290       1290 

There noon and midnight are labelled as strings. The rest of the columns are labelled as times formats (in strings). Lets change noon and midnight to the same format as the other times.

colnames(March_18_dat)[colnames(March_18_dat)%in%
                         c('X1.AM','X2.AM','X3.AM','X4.AM','X5.AM','X6.AM',
                           'X7.AM','X8.AM','X9.AM','X10.AM','X11.AM',
                           'X1.PM','X2.PM','X3.PM','X4.PM','X5.PM','X6.PM',
                           'X7.PM','X8.PM','X9.PM','X10.PM','X11.PM','Noon','Midnight')] <-
  c('X1.00.AM','X2.00.AM','X3.00.AM','X4.00.AM','X5.00.AM','X6.00.AM',
    'X7.00.AM','X8.00.AM','X9.00.AM','X10.00.AM','X11.00.AM',
    'X1.00.PM','X2.00.PM','X3.00.PM','X4.00.PM','X5.00.PM','X6.00.PM',
    'X7.00.PM','X8.00.PM','X9.00.PM','X10.00.PM','X11.00.PM','X00.00.AM','X00.00.PM')
March_18_dat <- March_18_dat %>% select(Detector_ID,Metric,Date,Date_Posixct,filename,everything())

Melt the data

March_18_melt <- melt(March_18_dat,id.vars = c('Detector_ID','Metric','Date','Date_Posixct','filename'),variable.name = "Time",value.name = 'Metric_value')

Create Date_Time variable

#remove X
March_18_melt$Time <- gsub('X','',March_18_melt$Time)
March_18_melt$Date_Time <- as.POSIXct(paste(March_18_melt$Date,March_18_melt$Time),format="%Y/%m/%d %I.%M.%p")
March_18_melt$Hour <- hour(March_18_melt$Date_Time)

Filter to the PM Peak hours, 2pm to 7pm.

PM_Peak <- c(14:19)
March_18_melt_PM_Peak <- March_18_melt %>%
  filter(Hour>=14)%>%
  filter(Hour<=19)

Lets find what detectors have bad values.

var <- March_18_melt_PM_Peak %>% 
  group_by(Detector_ID)%>%
  summarise(NAs =sum(Metric_value<0))%>%
  arrange(NAs)%>%
  filter(NAs==0)%>%
  droplevels()
  
no_NAs <- as.vector(var$Detector_ID)

Time Series

Lets pick Detector 70. We want to create a variable for each day and them average the volumes for each day.

We also only want Tuesday, Wednesday and Thursday.

Det_70 <-  March_18_melt_PM_Peak %>%
  filter(Detector_ID==150)%>%
  filter(Metric=="Volume")%>%
  mutate(YearDay=yday(Date_Time),
         Weekday=weekdays(Date_Time,abbreviate=TRUE))%>%
  # filter(Weekday %in% c('Tue','Wed','Thu'))%>%
  group_by(Date_Posixct)%>%
  summarise(SumVol = sum(Metric_value))
head(Det_70)

Now we create a time series for the data

Det_70_ts_xts <- xts(Det_70$SumVol,order.by = Det_70$Date_Posixct)
dygraph(xts(Det_70$SumVol,order.by = Det_70$Date_Posixct))%>%
  dySeries(label = 'Total Vol.')%>%
  dyRangeSelector()

Det_70_ts <- ts(Det_70$SumVol,frequency=3)
Det_70_ts_deomp <- decompose(Det_70_ts)
Det_70_ts_stl <- stl(Det_70_ts,s.window = 'periodic')
midweek <- c('Tuesday','Wednesday','Thursday')
day_select <-  cbind(data.frame(Det_70_ts_stl$time.series[,1:3]),Date=Det_70$Date_Posixct,Weekday=weekdays(Det_70$Date_Posixct))%>%
  # mutate(Resid = abs(remainder))%>%
  filter(Weekday %in% midweek)%>%
  arrange(remainder)%>%
  print()

day_select$Date[day_select$remainder==median(day_select$remainder)]

[1] "2018-03-29 CDT"

FM_TS_F$Date[FM_TS_F$remainder==median(FM_TS_F$remainder)]

Error: object 'FM_TS_F' not found

Day selection is Tuesday 2018-03-13.

Correlation

Show plots of volumes by day

y <- March_18_melt_PM_Peak %>%
  mutate(Weekday = weekdays(Date_Time,abbreviate=TRUE),
         YearDay=yday(Date_Time),
         MonthDay=day(Date_Time),
         HourMin = as.numeric(format(Date_Time,"%H.%M")))%>%
  filter(Metric=='Volume')%>%
  filter(Detector_ID%in%c(147:151))%>%
  filter(Weekday %in% c('Tue','Wed','Thu'))

  ggplot(y,aes(x=Metric_value,color=as.factor(Detector_ID)))+
  geom_density()+facet_wrap(~MonthDay,nrow=4,scales = 'free_x')

Create detector ~ day matrix

d3heatmap(matrix2,scale = 'row',Colv = 'as-is',colors = 'Blues')

Invalid value for Colv, ignoring

Cluster Days

day_SDev <- March_18_melt_PM_Peak %>%
  mutate(Weekday = weekdays(Date_Time,abbreviate=TRUE),
         YearDay=yday(Date_Time),
         MonthDay=day(Date_Time),
         HourMin = as.numeric(format(Date_Time,"%H.%M")))%>%
  filter(Metric=='Volume')%>%
  group_by(Detector_ID,Date_Posixct)%>%
  summarise(SumVol = sum(Metric_value))%>%
  group_by(Date_Posixct)%>%
  summarise(SDev = sd(SumVol))%>%
  mutate(weekDay=weekdays(Date_Posixct,abbreviate=TRUE))

sundays <-day_SDev$Date_Posixct[day_SDev$weekDay%in%c('Sun')]

ggplot(day_SDev) + 
  geom_point(aes(Date_Posixct,SDev)) + 
  geom_rug(aes(Date_Posixct,SDev)) + 
  geom_vline(xintercept = sundays,linetype='dotted') +
  theme_tufte(ticks = F) +
  xlab("STD of the total volume across all Detectors") + 
  ylab("Date") + 
  theme(axis.title.x = element_text(vjust=-0.5), axis.title.y = element_text(vjust=1))

Cumulative running total